home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / src / xfinfoTree.tcl < prev    next >
Encoding:
Text File  |  1993-11-20  |  13.4 KB  |  360 lines
  1. # Program: xf
  2. # Description: info routine for widget tree displaying
  3. #
  4. # $Header: xfinfoTree.tcl[2.4] Wed Mar 10 12:06:22 1993 garfield@garfield frozen $
  5.  
  6. ##########
  7. # Procedure: XFInfoWidgetTree
  8. # Description: show the widget tree in a canvas
  9. # Arguments: none
  10. # Returns: none
  11. # Sideeffects: none
  12. ##########
  13. proc XFInfoWidgetTree {} {
  14.   global xfBind
  15.   global xfConf
  16.   global xfMisc
  17.  
  18.   set xfMisc(widgetTreeCurrent) ""
  19.  
  20.   # build widget structure
  21.   XFTmpltToplevel .xfInfoWidgetTree 400x400 {XF widget tree}
  22.  
  23.   XFTmpltFrame .xfInfoWidgetTree.frame0 0
  24.  
  25.   button .xfInfoWidgetTree.frame0.ok \
  26.     -text {OK} \
  27.     -command {destroy .xfInfoWidgetTree}
  28.  
  29.   button .xfInfoWidgetTree.frame0.print \
  30.     -text {Print to (./xfWidgetTree)} \
  31.     -command {
  32.       global tkVersion
  33.       if {$tkVersion >= 3.0} {
  34.         set xfBBox [.xfInfoWidgetTree.frame1.canvas2 bbox all]
  35.         .xfInfoWidgetTree.frame1.canvas2 postscript -file ./xfWidgetTree -x 0 -y 0 -width [lindex $xfBBox 2] -height [lindex $xfBBox 3]}}
  36.  
  37.   checkbutton .xfInfoWidgetTree.frame0.rescanperm \
  38.     -offvalue 0 \
  39.     -onvalue 1 \
  40.     -text {Rescan permanently} \
  41.     -variable xfConf(scanTree)
  42.  
  43.   button .xfInfoWidgetTree.frame0.rescan \
  44.     -text {Rescan} \
  45.     -command {XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10}
  46.  
  47.   XFTmpltFrame .xfInfoWidgetTree.frame1 0
  48.  
  49.   scrollbar .xfInfoWidgetTree.frame1.scrollbar3 \
  50.     -command {.xfInfoWidgetTree.frame1.canvas2 xview} \
  51.     -orient {horizontal} \
  52.     -relief {raised}
  53.  
  54.   scrollbar .xfInfoWidgetTree.frame1.scrollbar1 \
  55.     -command {.xfInfoWidgetTree.frame1.canvas2 yview} \
  56.     -relief {raised}
  57.  
  58.   canvas .xfInfoWidgetTree.frame1.canvas2 \
  59.     -confine {true} \
  60.     -height {207} \
  61.     -relief {raised} \
  62.     -scrollregion {0c 0c 20c 20c} \
  63.     -width {295} \
  64.     -xscrollcommand {.xfInfoWidgetTree.frame1.scrollbar3 set} \
  65.     -yscrollcommand {.xfInfoWidgetTree.frame1.scrollbar1 set}
  66.  
  67.   menu .xfInfoWidgetTree.frame1.canvas2.m
  68.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  69.          -label {Parameters} \
  70.          -command {
  71.            global xfMisc
  72.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  73.              XFProcConfParametersDefault $xfMisc(widgetTreeCurrent)}}
  74.        .xfInfoWidgetTree.frame1.canvas2.m add separator
  75.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  76.          -label {Packing} \
  77.          -command {
  78.            global xfMisc
  79.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  80.              XFProcConfPacking $xfMisc(widgetTreeCurrent)}}
  81.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  82.          -label {Placing} \
  83.          -command {
  84.            global xfMisc
  85.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  86.              XFProcConfPlacing $xfMisc(widgetTreeCurrent)}}
  87.        .xfInfoWidgetTree.frame1.canvas2.m add separator
  88.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  89.          -label {Binding} \
  90.          -command {
  91.            global xfMisc
  92.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  93.              XFProcConfBinding $xfMisc(widgetTreeCurrent)}}
  94.        .xfInfoWidgetTree.frame1.canvas2.m add separator
  95.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  96.          -label {Parameters (small)} \
  97.          -command {
  98.            global xfMisc
  99.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  100.              XFProcConfParametersSmall $xfMisc(widgetTreeCurrent)}}
  101.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  102.          -label {Parameters (special)} \
  103.          -command {
  104.            global xfMisc
  105.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  106.              XFProcConfParametersSpecial $xfMisc(widgetTreeCurrent)}}
  107.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  108.          -label {Parameters (general)} \
  109.          -command {
  110.            global xfMisc
  111.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  112.              XFProcConfParametersGeneral $xfMisc(widgetTreeCurrent)}}
  113.        .xfInfoWidgetTree.frame1.canvas2.m add separator
  114.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  115.          -label {Paste} \
  116.          -command {
  117.            global xfMisc
  118.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  119.              XFProcEditPaste $xfMisc(widgetTreeCurrent)}}
  120.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  121.          -label {Copy} \
  122.          -command {
  123.            global xfMisc
  124.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  125.              XFProcEditCopy $xfMisc(widgetTreeCurrent)}}
  126.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  127.          -label {Cut} \
  128.          -command {
  129.            global xfMisc
  130.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  131.              XFProcEditCut $xfMisc(widgetTreeCurrent)}}
  132.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  133.          -label {Delete} \
  134.          -command {
  135.            global xfMisc
  136.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  137.              XFProcEditDelete $xfMisc(widgetTreeCurrent)}}
  138.        .xfInfoWidgetTree.frame1.canvas2.m add separator
  139.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  140.          -label {Hide subtree} \
  141.          -command {
  142.            global xfMisc
  143.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  144.              if {[lsearch $xfMisc(widgetTreeHidden) $xfMisc(widgetTreeCurrent)] == -1} {
  145.                lappend xfMisc(widgetTreeHidden) $xfMisc(widgetTreeCurrent)
  146.                XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10}}}
  147.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  148.          -label {Show subtree} \
  149.          -command {
  150.            global xfMisc
  151.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  152.              set xfTmpPos [lsearch $xfMisc(widgetTreeHidden) $xfMisc(widgetTreeCurrent)]
  153.              if {$xfTmpPos != -1} {
  154.                set xfMisc(widgetTreeHidden) [lreplace $xfMisc(widgetTreeHidden) $xfTmpPos $xfTmpPos]
  155.                XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10}}}
  156.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  157.          -label {Select as root} \
  158.          -command {
  159.            global xfMisc
  160.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  161.              set xfMisc(widgetTreeRoot) $xfMisc(widgetTreeCurrent)
  162.              XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10}}
  163.        .xfInfoWidgetTree.frame1.canvas2.m add command \
  164.          -label {Select . as root} \
  165.          -command {
  166.            global xfMisc
  167.            if {"$xfMisc(widgetTreeCurrent)" != ""} {
  168.              set xfMisc(widgetTreeRoot) .
  169.              XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10}}
  170.  
  171.   XFInfoWidgetTreeRead $xfMisc(widgetTreeRoot) 10 10
  172.  
  173.   # bindings
  174.   MenuPopupAdd .xfInfoWidgetTree.frame1.canvas2 1 \
  175.     .xfInfoWidgetTree.frame1.canvas2.m
  176.   bind .xfInfoWidgetTree.frame1.canvas2 "<ButtonPress-1>" {
  177.     set xfMisc(widgetTreeCurrent) [lindex [lindex [.xfInfoWidgetTree.frame1.canvas2 itemconfig [.xfInfoWidgetTree.frame1.canvas2 find closest [%W canvasx %x] [%W canvasy %y]] -tag] 4] 0]
  178.     MenuPopupPost .xfInfoWidgetTree.frame1.canvas2.m %X %Y}
  179.   bind .xfInfoWidgetTree.frame1.canvas2 $xfBind(configure) {
  180.     set xfW [lindex [lindex [.xfInfoWidgetTree.frame1.canvas2 itemconfig [.xfInfoWidgetTree.frame1.canvas2 find closest [%W canvasx %x] [%W canvasy %y]] -tag] 4] 0]
  181.     if {"$xfW" != ""} {
  182.       XFMiscFlash $xfW
  183.       XFProcConfParametersDefault $xfW}}
  184.   bind .xfInfoWidgetTree.frame1.canvas2 $xfBind(select) {
  185.     set xfW [lindex [lindex [.xfInfoWidgetTree.frame1.canvas2 itemconfig [.xfInfoWidgetTree.frame1.canvas2 find closest [%W canvasx %x] [%W canvasy %y]] -tag] 4] 0]
  186.     if {"$xfW" != ""} {
  187.       XFMiscFlash $xfW
  188.       XFEditSetPath $xfW}}
  189.   bind .xfInfoWidgetTree.frame1.canvas2 $xfBind(showName) {
  190.     set xfW [lindex [lindex [.xfInfoWidgetTree.frame1.canvas2 itemconfig [.xfInfoWidgetTree.frame1.canvas2 find closest [%W canvasx %x] [%W canvasy %y]] -tag] 4] 0]
  191.     if {"$xfW" != ""} {
  192.       .xfEdit.curSelected delete 0 end
  193.       .xfEdit.curSelected insert 0 $xfW
  194.       .xfEdit.curSelected select from 0
  195.       .xfEdit.curSelected select to end}}
  196.  
  197.   # packing
  198.   pack append .xfInfoWidgetTree.frame0 \
  199.               .xfInfoWidgetTree.frame0.ok {left fill expand} \
  200.               .xfInfoWidgetTree.frame0.print {left fill expand} \
  201.               .xfInfoWidgetTree.frame0.rescanperm {left fill expand} \
  202.               .xfInfoWidgetTree.frame0.rescan {left fill expand}
  203.   pack append .xfInfoWidgetTree.frame1 \
  204.               .xfInfoWidgetTree.frame1.scrollbar1 "$xfConf(scrollSide) filly" \
  205.               .xfInfoWidgetTree.frame1.canvas2 {top expand fill} \
  206.               .xfInfoWidgetTree.frame1.scrollbar3 {top fillx} 
  207.   pack append .xfInfoWidgetTree \
  208.               .xfInfoWidgetTree.frame0 {bottom fill} \
  209.               .xfInfoWidgetTree.frame1 {bottom fill expand}
  210. }
  211.  
  212. ##########
  213. # Procedure: XFInfoWidgetTreeRead
  214. # Description: update the widget tree in a canvas
  215. # Arguments: xfW - the current widget
  216. #            xfX - current X offset
  217. #            xfY - current Y offset
  218. # Returns: none
  219. # Sideeffects: none
  220. ##########
  221. proc XFInfoWidgetTreeRead {xfW xfX xfY} {
  222.   global symbolicName
  223.   global xfMisc
  224.   global xfPath
  225.  
  226.   if {"$xfW" == "$xfMisc(widgetTreeRoot)"} {
  227.     set xfMisc(widgetTreeY) 10
  228.     foreach xfCounter [.xfInfoWidgetTree.frame1.canvas2 find all] {
  229.       .xfInfoWidgetTree.frame1.canvas2 delete $xfCounter
  230.     }
  231.   }
  232.   
  233.   if {("[info commands $xfW]" == "" && "$xfW" != ".") ||
  234.       [string match ".xf*" $xfW] ||
  235.       ([string match "xf*" [winfo name $xfW]] && "$xfW" != ".")} {
  236.     return
  237.   }
  238.   if {[file exists $xfPath(lib)/edge/[winfo class $xfW]]} {
  239.     set item [.xfInfoWidgetTree.frame1.canvas2 create bitmap $xfX $xfMisc(widgetTreeY) -bitmap @$xfPath(lib)/edge/[winfo class $xfW] -anchor nw -tag $xfW]
  240.   } {
  241.     if {[file exists $xfPath(lib)/edge/Unknown]} {
  242.       set item [.xfInfoWidgetTree.frame1.canvas2 create bitmap $xfX $xfMisc(widgetTreeY) -bitmap @$xfPath(lib)/edge/Unknown -anchor nw -tag $xfW]
  243.     } {
  244.       set item [.xfInfoWidgetTree.frame1.canvas2 create rectangle $xfX $xfMisc(widgetTreeY) [expr $xfX+40] [expr $xfMisc(widgetTreeY)+40] -tag $xfW]
  245.     }
  246.   }
  247.  
  248.   set xfCounter3 ""
  249.   foreach xfCounter2 [array names symbolicName] {
  250.     set xfArrayName ""
  251.     append xfArrayName symbolicName ( $xfCounter2 )
  252.     if {"$xfW" == "[set $xfArrayName]"} {
  253.       set xfCounter3 $xfCounter2
  254.       break
  255.     }
  256.   }
  257.   if {"$xfCounter3" != ""} {
  258.     set itemText [.xfInfoWidgetTree.frame1.canvas2 create text [expr $xfX+50] [expr $xfMisc(widgetTreeY)+30] -text "[winfo name $xfW] = $xfCounter3" -anchor sw -tag $xfW]
  259.   } {
  260.     set itemText [.xfInfoWidgetTree.frame1.canvas2 create text [expr $xfX+50] [expr $xfMisc(widgetTreeY)+30] -text [winfo name $xfW] -anchor sw -tag $xfW]
  261.   }
  262.  
  263.   if {"$xfW" != "$xfMisc(widgetTreeRoot)"} {
  264.     set itemLine [.xfInfoWidgetTree.frame1.canvas2 create line $xfX [expr $xfMisc(widgetTreeY)+20] [expr $xfX-30] [expr $xfMisc(widgetTreeY)+20] [expr $xfX-30] [expr $xfY-10]]
  265.   }
  266.  
  267.   incr xfMisc(widgetTreeY) 50
  268.   set xfY $xfMisc(widgetTreeY)
  269.   if {[lsearch $xfMisc(widgetTreeHidden) $xfW] != -1} {
  270.     set itemLine [.xfInfoWidgetTree.frame1.canvas2 create line [expr $xfX+20] [expr $xfMisc(widgetTreeY)-5] [expr $xfX+20] [expr $xfY-10]]
  271.   } {
  272.     foreach xfCounter [winfo children $xfW] {
  273.       XFInfoWidgetTreeRead $xfCounter [expr $xfX+50] $xfY
  274.     }
  275.   }
  276.  
  277.   if {"$xfW" == "$xfMisc(widgetTreeRoot)"} {
  278.     set xfBBox [.xfInfoWidgetTree.frame1.canvas2 bbox all]
  279.     .xfInfoWidgetTree.frame1.canvas2 config -scrollregion "0c 0c [expr [lindex $xfBBox 2]+20] [expr [lindex $xfBBox 3]+20]"
  280.   }
  281. }
  282.  
  283. ##########
  284. # Procedure: XFInfoTreeSaveEdge
  285. # Description: save the current widget tree to a file
  286. # Arguments: xfFileName - the file to save to
  287. # Returns: none
  288. # Sideeffects: none
  289. ##########
  290. proc XFInfoTreeSaveEdge {xfFileName} {
  291.  
  292.   if {[catch "open $xfFileName w" xfOutFile] != 0} {
  293.     XFProcError "$xfOutFile"
  294.   } {
  295.     puts $xfOutFile "graph: {"
  296.     puts $xfOutFile "  /* graph attributes */"
  297.     puts $xfOutFile "  yspace: 50"
  298.     puts $xfOutFile "  orientation: left_to_right"
  299.     puts $xfOutFile "  edge.arrowwidth: 8"
  300.     puts $xfOutFile "  edge.arrowheight: 8"
  301.     puts $xfOutFile ""
  302.     puts $xfOutFile "  /* list of nodes */ "
  303.     XFInfoTreeSaveEdgeNodes $xfOutFile .
  304.     puts $xfOutFile "  /* list of edges */"
  305.     XFInfoTreeSaveEdgeEdges $xfOutFile .
  306.     puts $xfOutFile "}"
  307.     close $xfOutFile
  308.   }
  309. }
  310.  
  311. ##########
  312. # Procedure: XFInfoTreeSaveEdgeNodes
  313. # Description: save the current widgets as nodes
  314. # Arguments: xfOutFile - the output file id
  315. #            xfW - the current widget
  316. # Returns: none
  317. # Sideeffects: none
  318. ##########
  319. proc XFInfoTreeSaveEdgeNodes {xfOutFile xfW} {
  320.   global xfPath
  321.  
  322.   if {(![string match ".xf*" $xfW] &&
  323.        ![string match "xf*" [winfo name $xfW]]) ||
  324.       "$xfW" == "."} {
  325.     if {[file exists $xfPath(lib)/edge/[winfo class $xfW]]} {
  326.       puts $xfOutFile "  node: { title: \"$xfW\" label: \"[winfo name $xfW]\" iconfile: \"[winfo class $xfW]\" }"
  327.     } {
  328.       puts $xfOutFile "  node: { title: \"$xfW\" label: \"[winfo name $xfW]\" iconfile: \"Unknown\" }"
  329.     }
  330.   }
  331.   foreach xfCounter [winfo children $xfW] {
  332.     if {![string match ".xf*" $xfW] &&
  333.         ![string match "xf*" [winfo name $xfW]]} {
  334.       XFInfoTreeSaveEdgeNodes $xfOutFile $xfCounter
  335.     }
  336.   }
  337. }
  338.  
  339. ##########
  340. # Procedure: XFInfoTreeSaveEdgeEdges
  341. # Description: save the current widgets as edges
  342. # Arguments: xfOutFile - the output file id
  343. #            xfW - the current widget
  344. # Returns: none
  345. # Sideeffects: none
  346. ##########
  347. proc XFInfoTreeSaveEdgeEdges {xfOutFile xfW} {
  348.  
  349.   foreach xfCounter [winfo children $xfW] {
  350.     if {![string match ".xf*" $xfCounter] &&
  351.         ![string match "xf*" [winfo name $xfCounter]]} {
  352.       puts $xfOutFile "  edge: { sourcename: \"$xfW\" targetname: \"$xfCounter\" arrowstyle: line }"
  353.       XFInfoTreeSaveEdgeEdges $xfOutFile $xfCounter
  354.     }
  355.   }
  356. }
  357.  
  358. # eof
  359.  
  360.